C  SUBRS.  SCMSS, TYPE

	SUBROUTINE SCMSS
	COMMON/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
	DIMENSION RLIST(200),NOMOR(6),WARN(6),R(8,100)
	COMMON/SCX/RHY(4),JALPHA(19),RB,RC,JZ,IRHY,JD,KA,KB,IZ
	1/STF/RSTFAC(8),RSTJC/FRMT/F78F(1),FA1(1),FA5(1),IREAD
	1/XRN/RN(4000) /ALF/INP(72),ML /SC/J,L,MK 
	1,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,JG
	1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3))
	1,(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST),(R1,R,RN(3001))
	1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,
	1 JALPHA(6)),(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),
	1 (IDOT,JALPHA(3))
	DATA KSLA/'/'/,IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
	1,RHY/.5,.25,.125,.0625/,JALPHA/',','-','.','=','(',')','+',
	1 '*',':',';','"',' ','$','%','&','@','#','<','>'/
	IF(R1.EQ.16.)GO TO 16
C   FOR LETTERS
	IF(R1.NE.14.AND.R1.NE.144)GO TO 11
	MODE=1
	IBEAM=-1
	IZ=0
	IREAD=0
11	IF(MODE)GO TO 111
	IF(R1.NE.144.)GO TO (1,2,3,4,5,8024)MODE
2302	TYPE 80053
	IF(IREAD.EQ.1)REREAD 21141,L,INP
	IF(IREAD.EQ.0)TYPE 80051
	ACCEPT 80052,STAFF,L
	IF(STAFF.GE.99)GO TO 8027
C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
	IF(IREAD.EQ.1)GO TO 80041
	IF(LOOK(L)+LOOKD(L).EQ.0)GO TO 2302
	IREAD=1
	REWIND 22
	CALL IFILE(22,L)
2301	READ(22,21141,END=8027),L,INP
	IF(MODE.EQ.6)GO TO 1111
	IF(INP1.EQ.IBLA)GO TO 8006
	GO TO 80041
CC1112	REREAD 21141,L,INP
C  BECAUSE INP GOT WIPED OUT LAST TIME AROUND!
CC	GO TO 80041
1111	MODE=-1
	R(2,IZ+1)=-1.
	REND=1.0
	GO TO 8026
C   ABOVE ALLOWS MORE STAVES TO BE READ

111	IZ=0
	MODE=1
	GO TO 2302
C  WILL READ ANOTHER STAFF
80053	FORMAT(' TYPE STAFF NUM. '$)
80051	FORMAT('+AND FILE NAME  '$)
80052	FORMAT(F,A5)

2	TYPE 8008,IRHY
CC	GO TO 80042
	GO TO 1
3	TYPE 8002
330	ACCEPT 2114,N,L,INP3,INP4
	IF(N.EQ.'G')GO TO 8024
C  TYPE 'GO' TO PASS LATER ITEMS
	IF(N.EQ.'9'.OR.N.EQ.'B')GO TO 99
	IF(N.EQ.'Y')GO TO 1
	IF(N.NE.'N'.AND.N.NE.IBLA)GO TO 11
C  PICKS UP TYPOS
2000	MODE=MODE+1
	GO TO 11
4	TYPE 8023
	GO TO 330
5	TYPE 8022
	GO TO 330
8024	REND=-1.
	CALL HYDPOG(3)
C  ERASES NOTE NUMBERS
	IF(IBEAM)GO TO 8006
C  JUMP IF NO STEM NORMALIZATION NEEDED
C	IF(MODE.LT.3)GO TO 8006
	IZ=IZ+1
	R(1,IZ)=19.
	R(2,IZ)=STAFF
C   ADJUSTS NOTE STEMS, ETC.
8006	MODE=MODE+1
	IF(IREAD.EQ.1)GO TO 2301
8026	R(1,IZ+1)=100.
	IF(IREAD.EQ.2)REND=1.
273	IF(IREAD.NE.1)INP(2)=0
C  WHY =0 ABOVE?????
	RETURN


8027	IREAD=2
	STAFF=99.
C  STEMS ON ALL STAVES WILL NORMALIZE
	GO TO 8024
C  READER IS NOW FINISHED

99	IF(INP3.EQ.'9')GO TO 999
C   ELSE GET ANOTHER CHANCE TO SAY 'NO'
C  99=BACKUP,  999=ESCAPE
	MODE=MODE-1
	IF(MODE.GE.1)GO TO 11
999	DO 2222 K=1,IZ
2222	R(1,K)=99.
9999	REND=100
	GO TO 8026

8008	FORMAT(' TYPE ',I2,' RHYTHMS')
8002	FORMAT(' ADD BEAMS?  '$)
8022	FORMAT(' ADD SLURS?  '$)
8023	FORMAT(' ADD MARKS?  '$)
8011	FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
8015	K=IRHY-I+1
	TYPE 8011,K
	IF(IREAD.EQ.0)GO TO 11
	IZ=0
	IREAD=0
	MODE=5
	GO TO 8024

6	MODE=5
	IF(IREAD.NE.0)GO TO 8006
CC1	TYPE 8005
1	CALL TYPE
CC80042	ACCEPT 2114,INP
	IF(INP1.EQ.IBLA) GO TO 1
	IF(INP1.EQ.'9'.AND.INP2.EQ.'9')GO TO 99
C  TYPE '99' TO BACK-UP
80041	IF(MODE.GE.3)GO TO 133
	RETRO=-1.
	I=1
	PARENS=0
	MOT=0
      JZ=1  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      KL=0  
      RA=0  
2408	MLX=1
	L=-1
	DO 2999 K=1,72
	N=INP(K)
	IF(N.EQ.IBLA)GO TO 2999
	L=0 
	IF(N.NE.ISTAR.AND.N.NE.ISEMI)GO TO 2999
C  READS 72 CHARS. INCLUDING *.
	INP(K+1)=ISEMI
	GO TO 1773
C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999	CONTINUE
	IF(IREAD.EQ.1)GO TO 8015
	GO TO 273
C   ERROR IF NO '*' OR ';' AT END OF LINE.

1299	IF(JZ.NE.0)GO TO 1773
7773	IF(IREAD.EQ.0)GO TO 77731
C   BYPASS IF NOT USING EDIT FILE
	READ(22,21141),L,INP
C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
	GO TO 77732
CC77731	TYPE 8005
CC  	ACCEPT 2114,INP
77731	CALL TYPE
	IF(INP1.EQ.IBLA)GO TO 7773
77732	JM=-1
	JZ=0
	GO TO 2408
C   'LISTS' MUST END WITH * 
1773	JZ=0
	DBST=1.
17731	ML=MLX
	IF(PARENS.LE.0.)GO TO 975
C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362	PARENS=0
	MOT=I-LMOT
	IF(LCNT+MOT.LT.198)GO TO 33621
	DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
	TYPE NOMOR,JMOT
	GO TO 1
33621	JLIST(LCNT+1)=MOT
	LCNT=LCNT+2
	DO 2140 JG=0,MOT-1
2140	RLIST(LCNT+JG)=V(LMOT+JG)
	LCNT=LCNT+MOT
	IF(IAMP)GO TO 3013
C  FOR CLOSE PARENS ON LAST ITEM
C   STORE MOTIVE IN RLIST ARRAY

975	DO 236 JDD=ML,72
	JD=JDD
	N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
	IF(N.NE.ILP.AND.N.NE.IRP.AND.N.NE.ICOL)GO TO 2361
	INP(JD)=IBLA
	IF(N.NE.ICOL)GO TO 1113
	DBST=-1.
	GO TO 236
C  FOR 'DOUBLE STOPS'
1113	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.')')GO TO 3361
C  ONLY ONE () AS YET,  NO NESTING
1140	JMOT=INP(L)
C   MOTIVE NAME
	DO 11401 JC=1,LCNT-1
	IF(JMOT.NE.JLIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
CC	GO TO 1
C  FOR BACKUP
11401	CONTINUE
	JLIST(LCNT)=JMOT
	PARENS=-1.
C   A PARENTH IS OPEN
	INP(L)=IBLA
	LMOT=I
C   LMOT IS CURRENT POINT IN V ARRAY
	GO TO 236
3361	IF(PARENS.NE.0)GO TO 33612
	DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
	TYPE WARN
33611	INP(JD)=IBLA
	GO TO 236
33612	PARENS=1.
C   SETS PARENS CLOSED FLAG
	GO TO 33611
C   NO INVERSIONS POSSIBLE NOW
2361	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.NEG)GO TO 7113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT
	IF(JG.NE.JLIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.ISTAR)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JM
	JM=-1
	INP(K)=IBLA
	JA=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
	JM=JC
140	JC=1
	KN=L+2
	M=KN+JLIST(L+1)
	IF(RETRO)GO TO 940
	KN=M-1
	M=L+1
	JC=-1
	RETRO=-1.

940	Z=RLIST(KN)
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(MODE.EQ.1)GO TO 440
C  MODE 1 IS NOTES, 2 IS RHY.
	V(I)=Z*VX1
	GO TO 7361
440	IF(Z.EQ.85.)GO TO 540
	V(I)=Z+VX1
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	RB=V(I-1)
	DO 8361 L=JD,72
	JG=INP(L)
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 93611
8361	IF(JG.EQ.ISTAR)IAMP=-1
9361	MLX=L
	IF(IAMP.EQ.0)GO TO 17731
	JZ=-1
93611	IF(IAMP)GO TO 3013
	GO TO 7773
6361	CONTINUE
	TYPE 6362,JG
	GO TO 11402
6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.NE.KSLA)GO TO 636
	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 103
	MLX=MLX+1
	GO TO 436
636	IF(N.EQ.ISEMI)GO TO 103
936	IF(N.NE.IDOT)GO TO 736
	L=INP(JD+1)
	KL=NALF(L)
	IF(L.GT.0.AND.KL.GE.0.AND.KL.LE.9)GO TO 236
C   JUMP IF IT'S A NUMBER
	IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(N.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
	GO TO 103
236	CONTINUE

C   FOR ENTERING TEXT: 16, POS., STF., NT#., SIZE,  RHYTHM≠0
2114	FORMAT(72A1)
21141	FORMAT(I,72A1)
16	RC=R(4,1)
	IBEAM=-1
	RB=R(3,1)
	RNFLG=R(5,1)
C  RNFLG ≠0 CALLS NOTE NUM. SETUP
161	CALL NOZERO(RC)
	CALL TYPE
	DO 31 KN=72,1,-1
31	IF(INP(KN).NE.IBLA)GO TO 33
C  KN=NUM OF CHARACTERS
C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
C  , - . = ( ) + * : ; " BLANK --THIS IS ORDER PAST ALPHAB.
C  $=UPPER CASE, %=LOWER, &=NON-ITALICS, @=ITALICS (48,49,50,51)
C  #=RETURN TO PRIMITVE FONT
33	L=1
	RA=R(2,1)
C   RA= ADDS UP TOTAL SPACE NEEDED
	RX=0
	RZ=-1
C   RB= NOTE #
C   RC= SIZE FACTOR
	IZ=0
CC	RBL=1.
368	IZ=IZ+1
CC	R(1,IZ)=16.
	R(2,IZ)=RA 
C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
	Y=39.6*RSTJC
C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
	R(3,IZ)=STAFF
	R(4,IZ)=RB
	R(5,IZ)=RC
CC	RBL=12.

	DO 364 JE=6,8
	Z=0
	DO 363 JD=1,4
361	IAMP=INP(L)
	IF(IAMP.NE.KSLA)GO TO 365
CC	RZ=-1
C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
	JC=JD
	R(1,IZ)=0
	DO 367 KA=JE,8
	X=.990
	DO 366 K=JC,4
	Z=Z+X
366	X=X*100.0
	R(KA,IZ)=Z
	JC=1
367	Z=0
	L=L+1
C  L=CHARACTER COUNTER
	GO TO 369
365	DO 362 J=1,19
	IF(IAMP.NE.JALPHA(J))GO TO 362
	N=35+J
CC	IF(N.GT.47)RBL=RBL-1.
C  FOUND A SPECIAL CHARACTER.
	GO TO 39
362	CONTINUE
38	N=10-('A'-INP(L))/536870912
C   MAGIC NUMBER TO FIND LETTERS
	IF(N.LT.10)N=N+7
39	L=L+1
C  BLANK=99(=47)
	CALL SPACER(N,IFNT,RX,3.30537)
C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
C  GET SPACE FOR THIS LETTER.
	X=N
	IF(JD.EQ.2)X=X*100.
	IF(JD.EQ.4)X=X/100.
	IF(JD.EQ.1)X=X*10000.
363	Z=Z+X
364	R(JE,IZ)=Z
369	R(1,IZ)=RX*RZ
C PUT AWAY NEG. OR POS. SPACE
	RA=RA+RX+5
	RX=0
	RZ=1.
	IF(IAMP.EQ.KSLA)RZ=-RZ
	IF(L.LE.KN)GO TO 368
CC	R(1,IZ)=0

	INP(1)=0
C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
	IF(RNFLG.NE.0)CALL SETLET
	GO TO 8024
C  PACKS 4 CHARS/WD, 3 WDS/ITEM.  ORDER=[, - . = ( )]  000000.00

5016	IF(IAMP.GE.0)GO TO 1299
	IF(PARENS.NE.0)GO TO 3362
C  PARENS ARE STILL OPEN?
	GO TO 3013
103	K=INP(ML)

C   LAST SECTION
	IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
1899	JA=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
      IF(VX1.EQ.-99.)GO TO 4022
	IF(MODE.NE.2)GO TO 17
C*********** MODE #?
2017	IF(VX1.EQ.10000.)GO TO 17
      VX1=4./VX1
	IF(JJ.NE.1)GO TO 2014
	V(I)=VX1
	GO TO 114
2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17	V(I)=VX1
	IF(JJ.LE.1)GO TO 114
	IF(MODE.NE.1.OR.VX2.EQ.0)GO TO 171
C  JUMP IF RHY OR 'X 4' ETC.
	V(I)=-(VX1/100.+VX2/10000.)
C  PACKS 2 METER NUMS INTO ONE SLOT (-.1208 = 12/8)
	GO TO 114
171	L=VX(JJ)-1
	X=V(I)
	NL=I+1
	I=L+I
	DO 1017 K=NL,I
1017	V(K)=X
C   ADDS UP TOTAL   OF NOTES IN SEQ.
	GO TO 114
1014	V(I)=RB
114      RB=V(I)     
      I=I+1 
      GO TO 5016    
4022      JC=VX2+.3
      JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
      DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
2005  V(L)=V(L-JC)
1005      I=I+JC  
	RB=V(NL)
C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
      GO TO 5016  

3013	IF(MODE.EQ.2.AND.I-1.NE.IRHY)GO TO 8015
C  WRONG NUMBER OF ITEMS
	V(I)=-99.
	IF(MODE.NE.1)GO TO 132
131	CALL NOTES
	GO TO 8006
132	CALL RHYTH
CC	IF(R1.EQ.50)GO TO 8024
C  =50 IS RHYTHM FOR TEXT
	IF(IREAD.EQ.0)CALL NUMB
	GO TO 8006
C   ACCENTS ARE IN BEAMS SUBROUTINE
133	CALL BEAMS
	IF(MODE.EQ.5)GO TO 8024
	IF(MODE.EQ.3)IBEAM=0
C  FOR  STEM NORMALIZATION
	GO TO 8006
	END

	SUBROUTINE TYPE
	COMMON/ALF/INP(72),ML
	TYPE 8005
	ACCEPT 2114,INP
2114	FORMAT(72A1)
8005	FORMAT(' TYPE --'/)
	END